home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Run Magazine ReRun 1984 Half 1
/
rerun-1984-01-06-side-a.d64
/
tlmusic may p132
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-09-20
|
8KB
|
224 lines
0 rem total music 64 ***
5 gosub 12000
10 clr: rem voice 1 notes
15 dim hi(200),lo(200),ln$(200):rem total number of notes possible is 200
20 poke53281,1:poke53280,1:printchr$(144)chr$(147)
30 up$=chr$(145):lf$=chr$(157)
40 fors=54272to54296:pokes,0:next
50 sv=54296:sh=54273:sl=54272:sa=54277:ss=54278:sw=54276
100 print"volume [1-15]";chr$(32)chr$(32)"15"
101 printup$;:forx=1to13:printchr$(29);:nextx
102 inputv1$
105 v1=val(v1$)
110 ifv1<1orv1>15thengosub7000
114 ifv1<1orv1>15thenprintup$up$up$:goto100
125 forx=1to22:printchr$(32);:next:print
200 print"waveform"
202 printtab(10)chr$(18)"t";chr$(146);"riangular"
204 printtab(10)chr$(18)"s";chr$(146);"awtooth"
206 printtab(10)chr$(18)"p";chr$(146);"ulse"
208 printtab(10)chr$(18)"n";chr$(146);"oise";chr$(32)chr$(32)"t"
209 printup$;:forx=1to15:printchr$(29);:next:inputw1$
210 ifw1$="t"thenw1=17:print:goto300
212 ifw1$="s"thenw1=33:print:goto300
214 ifw1$="p"thenw1=65:print:goto300
216 ifw1$="n"thenw1=129:print:goto300
220 ifw1$<>"n"thengosub7000
226 ifw1$<>"n"then forx=1to6:printup$;:next:print:goto200
300 print"attack/decay [0-240]";chr$(32)chr$(32)"0"
302 printup$;:forx=1to20:printchr$(29);:nextx:inputa1$
310 a1=val(a1$)
320 ifa1<0ora1>240thengosub7000
330 ifa1<0ora1>240thenprintup$up$:goto300
400 print"sustain/release [0-240]";chr$(32)chr$(32)"240"
402 printup$;:forx=1to23:printchr$(29);:nextx:inputs1$
410 s1=val(s1$)
420 ifs1<0ors1>240thengosub7000
430 ifs1<0ors1>240thenprintup$up$:goto400
450 print:print"duration of note";chr$(32)chr$(32)"128"
451 printup$;:forx=1to16:printchr$(29);:nextx:inputd1$
452 ifleft$(d1$,1)<"0"orleft$(d1$,1)>"9"thengosub7000
454 ifleft$(d1$,1)<"0"orleft$(d1$,1)>"9"thenprintup$up$up$:goto450
456 d1=val(d1$):print
458 forx=1to400:nextx
460 printchr$(147)chr$(18)"f3"chr$(146)" print & play";
461 printtab(24)chr$(18)"f7"chr$(146)" restart"
462 printchr$(18)" p"chr$(146)" pause";
463 printspc(12)chr$(18)"return"chr$(146)" line feed"
464 printchr$(18)" "chr$(94)chr$(146)" erase all";
465 printspc(6)chr$(18)"inst/del"chr$(146)" erase note" :print:print
467 formd=0to39:poke1624+md,67:poke55896+md,12:nextmd
480 geta$:ifa$=""then480
499 rem **** a$ selection for notes- octave 4
500 ifa$=chr$(65)then hi=28:lo=49:goto700: rem a
510 ifa$=chr$(193)then hi=29:lo=223:a$="a#":goto700:rem a#
520 ifa$=chr$(66)then hi=15:lo=210:goto700: rem b ** note octave 3 not 4 ***
530 ifa$=chr$(67)then hi=16:lo=195:goto700: rem c
540 ifa$=chr$(195)then hi=17:lo=195:a$="c#":goto700:rem c#
550 ifa$=chr$(68)then hi=18:lo=209:goto700: rem d
560 ifa$=chr$(196)then hi=19:lo=239:a$="d#":goto700:rem d#
570 ifa$=chr$(69)then hi=21:lo=31:goto700: rem e
580 ifa$=chr$(70)then hi=22:lo=96:goto700: rem f
590 ifa$=chr$(198)then hi=23:lo=181:a$="f#":goto700:rem f#
600 ifa$=chr$(71)then hi=25:lo=30:goto700: rem g
610 ifa$=chr$(199)then hi=26:lo=156:a$="g#":goto700:rem g#
620 ifa$=chr$(80)then hi=0:lo=0:a$="p":goto700: rem pause
635 ifa$=chr$(134)then 9000:rem f3 goto putting data into arrays
640 ifa$=chr$(136)then10:rem f7 restart
645 ifa$=chr$(13)thenprintup$chr$(13):goto480:rem return- line feed
650 ifa$=chr$(20)thenhi=0:lo=0:printchr$(157)chr$(157)chr$(32);:goto480
651 rem line650 -inst/del erase single note
660 ifa$=chr$(94)thengoto460:rem up arrow symbol clean up screen
690 ifa$<>chr$(80)thenhi=0:lo=0:goto480
700 pokesh,hi:pokesl,lo:pokesa,a1:pokess,s1:pokesw,w1:pokesv,v1
740 forx=1tod1:nextx
750 printa$;" ";:pokesv,16:pokesw,w1-1
800 goto480
1999 *** rem play the tune ***
2000 ifn=0 then return
2005 forx=54272 to 54296:pokes,0:nextx
2010 fornn=0ton-1:pokesh,hi(nn):pokesl,lo(nn)
2020 pokesa,a1:pokess,s1:pokesw,w1:pokesv,v1
2030 forx=1tod1:nextx
2040 nextnn:pokesv,16:pokesw,w1-1
2050 return
2999 rem *** print notes using letters ***************************************
3000 print
3002 qt$="notes by letter":gosub10000:forx=1to500:nextx
3005 qt$="turn printer on":gosub 10000:forx=1to500:nextx
3010 qt$="give tune a name":gosub10000:printup$:printtab(16);:inputaw$
3020 open1,4
3030 print#1,aw$:print#1
3040 fornn=0ton-1:print#1,ln$(nn);:print#1," ";:nextnn
3050 print#1:print#1,"total note count=";nn;"plus -1,-1"
3090 print#1:close1:goto9200
3095 printup$;:forx=0to39:printchr$(32);:nextx:printup$up$up$:print
3100 qt$="finished":gosub10000:goto9200
7000 qt$="not a legal choice":gosub10000:forx=1to50:nextx
7010 printup$:forx=1to30:printchr$(32);:fory=1to25:nexty:nextx:return
7999 rem *** data line only print ***
8000 print
8002 qt$="print data only":gosub10000:forx=1to500:nextx
8005 qt$="turn printer on":gosub10000:forx=1to500:nextx
8010 qt$="give tune a name":gosub10000:printup$:printtab(16);:inputaw$
8020 open1,4
8030 print#1,aw$:print#1
8040 fornn=0ton-1:print#1,hi(nn);",";lo(nn);",";:nextnn:print#1,"-1,-1"
8045 print#1:print#1,"total note count=";nn*2;"plus -1,-1"
8050 print#1:close1:return
8499 rem *** total program print ***
8500 print
8510 qt$="print routine":gosub10000:forx=1to500:nextx
8520 qt$="turn printer on":gosub10000:forx=1to500:nextx
8530 qt$="give tune a name":gosub10000:printup$:printtab(16);:inputaw$
8550 open1,4
8560 print#1,aw$
8565 print#1
8570 print#1,"100 for s=54272 to 54296 : poke s,0 : next s"
8580 print#1,"110 read sh,sl"
8590 print#1,"120 if sh=-1 then 180"
8600 print#1,"130 poke 54273, sh : poke 54272, sl"
8610 print#1,"140 poke 54277,";a1;": poke 54278,";s1;": poke 54276,";w1
8620 print#1,"150 poke 54296,";v1
8630 print#1,"160 for x=1 to ";d1;": next x"
8640 print#1,"170 goto 110"
8645 print#1,"180 poke 54296,0 : poke 54276,";w1-1
8650 print#1,"200 data ";
8660 fornn=0ton-1:print#1,hi(nn);",";lo(nn);",";:nextnn:print#1,"-1,-1"
8690 print#1:print#1,"total note count=";nn*2;"plus -1,-1"
8700 print#1:close1:goto9200:rem back for another a$ ***************
8999 rem put data into arrays
9000 printchr$(19);:forx=0to199:printchr$(32);:nextx
9005 printchr$(19);
9010 printchr$(18)"f1"chr$(146)" data only";
9011 printtab(15)chr$(18)"f2"chr$(146)" total print"
9020 printup$;chr$(18)"f3"chr$(146)" pratice";
9022 printspc(5)chr$(18)"f4"chr$(146)" print notes"
9025 printchr$(18)"f5"chr$(146)" play tune";
9030 printtab(15)chr$(18)"f6"chr$(146)" duration"
9031 printup$;chr$(18)"f7"chr$(146)" restart"
9032 printchr$(18)" p"chr$(146)" pause";
9035 printspc(7)chr$(18)" "chr$(94)chr$(146)" erase all"
9040 printchr$(19):forx=1to11:print:nextx:rem position line on grey line
9100 print"input notes into array routine";up$
9150 a$=chr$(94):goto9345:rem get screen and n set up properly
9200 geta$:ifa$=""then9200
9210 ifa$=chr$(65)then hi(n)=28:lo(n)=49:goto9400:rem a
9220 ifa$=chr$(193)then hi(n)=29:lo(n)=223:a$="a#":goto9400:rem a#
9230 ifa$=chr$(66)then hi(n)=15:lo(n)=210:goto9400:rem b *note octave 3 not 4*
9240 ifa$=chr$(67)then hi(n)=16:lo(n)=195:goto9400:rem c
9250 ifa$=chr$(195)then hi(n)=17:lo(n)=195:a$="c#":goto9400:rem c#
9260 ifa$=chr$(68)then hi(n)=18:lo(n)=209:goto9400:rem d
9270 ifa$=chr$(196)then hi(n)=19:lo(n)=239:a$="d#":goto9400:rem d#
9280 ifa$=chr$(69)then hi(n)=21:lo(n)=31:goto9400:rem e
9290 ifa$=chr$(70)then hi(n)=22:lo(n)=96:goto9400:rem f
9300 ifa$=chr$(198)then hi(n)=23:lo(n)=181:a$="f#":goto9400:rem f#
9310 ifa$=chr$(71)then hi(n)=25:lo(n)=30:goto9400:rem g
9320 ifa$=chr$(199)then hi(n)=26:lo(n)=156:a$="g#":goto9400:rem g#
9330 ifa$=chr$(80)then hi(n)=0:lo(n)=0:goto9400:rem p pause
9335 ifa$=chr$(133)thengosub8000:goto9200:rem f1 print data only
9340 ifa$=chr$(137)thengosub8500:goto9200:rem f2 print routine
9341 ifa$=chr$(134)thenprintchr$(147):n=0:goto458:rem f3 to pratice play
9342 ifa$=chr$(135)andn=0then9200
9343 ifa$=chr$(135)thengosub2000:goto9200:rem f5 play the tune
9344 ifa$=chr$(136)then10:rem f7 start all over
9345 ifa$=chr$(94)then10090
9346 ifa$=chr$(138)thengoto3000:rem f4 - print notes using letters
9347 ifa$=chr$(139)thenprint:print"duration";:input d1:goto9200:rem f6 duration
9350 ifa$<>chr$(80)then goto9200
9400 pokesh,hi(n):pokesl,lo(n):pokesa,a1:pokess,s1:pokesw,w1:pokesv,v1
9410 forx=1tod1:nextx
9420 printa$;" ";:pokesv,16:pokesw,w1-1:ln$(n)=a$:rem put ln - list notes
9440 n=n+1:goto9200 :rem increase array count & go back for another note
9999 rem *** this is scroll type routine*********************